home *** CD-ROM | disk | FTP | other *** search
/ Programming Sound Cards / Programming Sound Cards.iso / sound_56 / s3mplay.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-01  |  23KB  |  663 lines
  1. {$M 16000,0,0}
  2. {$I-,X+,V-,G+,D+}
  3. unit s3mplay;
  4.  
  5. INTERFACE
  6.  
  7. CONST version              = 1.70;
  8.       { Variable ranges }
  9.       MAX_samples          = 100; { 0..99 samples }
  10.       MAX_patterns         = 100; { 1..100 patterns }
  11.       MAX_orders           = 255; { 0..255 orders }
  12.       MAX_channels         =  32; { 0..31 channels }
  13.       { error constants }
  14.       noerror              = 0;
  15.       notenoughmem         = -1;
  16.       wrongformat          = -2;
  17.       filecorrupt          = -3;
  18.       filenotexist         = -4;
  19.       packedsamples        = -5; { sorry I don't know about DigiPlay 3.0 ADPCM packing
  20.                                    was anyway not used yet in S3Ms ... }
  21.       Allreadyallocbuffers = -6; { don't try to allocate memory for buffers twice }
  22.       nota386orhigher      = -7; { for playing any sound we need a 386 or higher -
  23.                                    sorry but I optimized it for a 486 (pipeline etc.) and it
  24.                                    runs fine on a 386 ;)
  25.                                    (Hey guys a 486DX is not that expensive - for
  26.                                    the same price I got an slow 386SX in 1991) }
  27.       nosounddevice        = -8; { before 'start playing' - set a sounddevice ! }
  28.       noS3Minmemory        = -9; { before 'start playing' - load a S3M ! }
  29.       ordercorrupt         = -10; { if there's no playable entry in order -> that would cause an endless
  30.                                     loop in readnotes if you try to play it }
  31.       internal_failure     = -11; { I'm sorry if this happend :( }
  32.       sample2large         = -12; { I can't handle samples >64511 }
  33.  
  34. {$I TYPDEF.INC}
  35.  
  36. { variables for public }
  37. VAR load_Error:integer;
  38.     player_Error:integer;
  39.     { Tables : }
  40.     Instruments:^TInstrArray;         { pointer to data for all instruments }
  41.     PATTERN   :TPatternSarray;        { segment for every pattern }
  42.                                       { $Fxyy -> at EMS page YY on Offset X*5120 }
  43.     ORDER     :TOrderArray;           { song arrangement }
  44.     Channel   :TchannelArray;         { all public/private data for every channel }
  45.     songname:string[28];              { name given by the musician }
  46.     { numbers of ? }
  47.     ordnum:word;
  48.     insnum:word;
  49.     Patnum:word;
  50.     usedchannels:byte;  { possible values : 1..32 (kill all Adlib) }
  51.     patlength   :word;    { length of one pattern }
  52.     savedunder:real;    { ST version file was created with }
  53.     { songposition : (you can change them while playing to jump arround) }
  54.     curorder   :word;   { position in song arrangement }
  55.     curpattern :byte;   { current pattern - is specified also by [curorder] - so it's only for the user ... }
  56.     curline    :byte;   { current line in pattern }
  57.     curtick    :byte;   { current tick  - we only calc one tick per call (look at MIXING.ASM) }
  58.     lastorder  :byte;   { -> last order to play ... }
  59.     Ploop_on   :boolean;{ in a Pattern loop? }
  60.     Ploop_no   :byte;   { number of loops left }
  61.     Ploop_to    :byte;   { position to loop to }
  62.     patterndelay:byte;
  63.  
  64.     gVolume    :byte;    { global volume -> usedvol = instrvol*gvolume/255 }
  65.     loopS3M    :boolean; { flag if restart if we reach the end of the S3M module }
  66.     EndOfSong  :boolean;
  67.     toslow     :boolean;
  68.     justinfill :boolean;
  69.     rastertime :boolean;
  70.     useEMS     :boolean;
  71.     FPS        :byte;     { frames per second ... default is about 70Hz }
  72.     LQmode     :boolean;  { flag if lowquality mode }
  73.  
  74.     DMArealbufsize:array[0..63] of word; { e.g. 0,128,256,384 <- positions of dmabuffer parts (changes with samplerate) }
  75.  
  76.     TickBytesLeft:word;    { Bytes left to next Tick }
  77.  
  78.     {$IFDEF BETATEST}
  79.     startorder :word;
  80.     {$ENDIF}
  81.  
  82.     playbuffer :pointer; { pointer to DMAbuffer - for public use, but don't write into it !!!
  83.                            - it's never used for any action while mixing !
  84.                            - while playing you can read the DMA base counter
  85.                            and find out in that way what sample value the
  86.                            SB currently plays ... refer to DMA Controller }
  87.     DMAhalf     :byte;     { last DMAbuffer part to calculate }
  88.     numBuffers  :byte;     { number of parts in DMAbuffer }
  89.     { EMS things : }
  90.     patEMShandle :WORD;    { handle to access EMS for patterns }
  91.     smpEMShandle :WORD;    { hanlde to access EMS for samples <- I seperated them, but that does not matter, well ? }
  92.     savHandle    :WORD;    { EMS handle for saving mapping while playing }
  93.     EMSpat       :boolean; { patterns in EMS ? }
  94.     EMSsmp       :boolean; { samples in EMS ? }
  95.     PatperPage   :byte;    { count of patterns per page (<64!!!) }
  96.  
  97. FUNCTION  load_s3m(name:string):BOOLEAN;        { load S3M module into memory }
  98. PROCEDURE done_module;                          { free memory used by S3M }
  99. FUNCTION  Init_device(input:byte):boolean;       { = false if set device failed }
  100. FUNCTION  Init_S3Mplayer:boolean;                { init DMAbuffer,tickbuffer,volumetable and some variables }
  101. PROCEDURE Done_S3Mplayer;                       { free buffers used by player }
  102. PROCEDURE setSampleRate(var SR:word;stereo:boolean); { set SampleRate for playing mono/stereo - higher frequency
  103.                                                            means more processor time for calc sound
  104.                                                            stereo question is because possible stereo/mono rates may differ }
  105. FUNCTION  startplaying(var A_stereo,A_16Bit:boolean;LQ:Boolean):Boolean;
  106.                                                               (* play totaly in background - you have nothin else to do
  107.                                                                  for continue playing !
  108.                                                                  It'll interrupt your program itself and calculate
  109.                                                                  the next data is required *)
  110. procedure set_mastervolume(vol:byte);
  111. procedure set_ST3order(new:boolean);             (* look at ST3order *)
  112. { To get some infos : }
  113. function getspeed:byte;
  114. function gettempo:byte;
  115. function get_mvolume:byte;
  116. function get_delay:byte;
  117. function getSamplerate:word;
  118. function getusedEMSsmp:longint;    { get size of samples in EMS }
  119. function getusedEMSpat:longint;    { get size of patterns in EMS }
  120.  
  121. { not supported functions: }
  122. FUNCTION getuseddevice(var typ:byte;var base:word;var dma8,dma16:byte;var irq:byte):byte;
  123. FUNCTION load_specialdata(var p):boolean; { allocate memory and load special data from file }
  124.  
  125. IMPLEMENTATION
  126.  
  127. uses EMStool,blaster,crt,dos;
  128.  
  129. CONST DMAbuffersize=8*1024; { <- maximum size of DMAbuffer }
  130.  
  131. { Internal variables : }
  132. VAR S3M_inMemory:BOOLEAN;
  133.     PROC386:boolean;      { A 386 processor ? }
  134.     filename:string;      { name of file currently in memory }
  135.     buffersreserved:boolean;
  136.     sounddevice :boolean;
  137.     Samplerate  :word;
  138.     Userate     :word;
  139.     { mixing variables : }
  140.     tickbuffer  :pointer;  { the well known buffer for one tick - size depends on _currennt_tempo_ }
  141.     DMAbuffer   :pointer;  { DMA and SB loop inside ... and we copy data into that buffer }
  142.     AllocBuffer :pointer;  { position where we allocate DMA buffer - remember that we may use second half ... }
  143.     lastready   :byte;     { last ready calculated DMAbuffer part }
  144.     volumetablePTR : pointer; { pointer to volumetable (see CALCVolumetable) }
  145.     { S3M flags : }
  146.     st2vibrato  :boolean; { not supported }
  147.     st2tempo    :boolean; { not supported }
  148.     amigaslides :boolean; { not supported }
  149.     SBfilter    :boolean; { not supported }
  150.     costumeflag :boolean; { not supported - set if costumedata }
  151.     vol0opti    :boolean; { PSIs volume 0 optimization }
  152.     amigalimits :boolean; { check for amiga limits }
  153.     stereoflag  :boolean; { not supported - we do what's possible on detected SB }
  154.     signeddata  :boolean; { signed/unsigned data (only volumetable differs in those modes) }
  155.     { options : }
  156.     mvolume      :byte;   { master volume -> calc posttables }
  157.     initspeed    :byte;   { initial speed }
  158.     inittempo    :byte;   { initial tempo }
  159.     curspeed     :byte;   { current speed - length of one tick }
  160.     curtempo     :byte;   { current tempo - count of ticks per note }
  161.     { own Flags : }
  162.     ST3order   :boolean; { if true then handle order like ST3 - if a "--"=255 is found -
  163.                            stop or loop to the song start (look loopS3M) }
  164.                          { if false - play the whole order and simply skip the "--"
  165.                            if curorder=ordnum then stop or loop to the beginning }
  166.     
  167.     BPT          :word;   { bytes per tick - depends on samplerate + tempo }
  168.  
  169.     { some saved values for correct restoring former status : }
  170.     oldexitproc  :pointer;
  171.     { tables for mixing : }
  172.  
  173.     post8bit     :array[0..4095] of byte;
  174.     post16bit    :array[0..4095] of word;
  175.  
  176.     sinuswave,
  177.     rampwave     :array[0..63] of shortint;
  178.     squarewave   :array[0..63] of byte;
  179.  
  180. {$L DOSPROC.OBJ}
  181. function getdosmem(var p;anz:longint):boolean; external;
  182. procedure freedosmem(var p); external;
  183. function getfreesize:word; external;
  184. function setsize(var p;anz:longint):boolean; external;
  185.  
  186. {$L EMS4FCT.OBJ}
  187. procedure setEMSnames; near; external;
  188.  
  189. {$L READNOTE.OBJ}
  190. procedure readnewnotes; near; external;
  191. procedure SetupNewInst; near; external; { don't call it from pascal - has its internal use }
  192. procedure SetnewNote;   near; external; { don't call it from pascal - has its internal use }
  193.  
  194. {$L MIXING.OBJ}
  195. procedure calc_mono_tick; near; external;
  196. procedure calc_stereo_tick; near; external;
  197.  
  198. {$L VOLUME.OBJ}
  199. procedure calcVolumeTable; near; external;
  200.  
  201. {$L PROCESSO.OBJ}
  202. function check386:boolean; near; external;
  203.  
  204. {$L FILLDMA.OBJ}
  205. procedure fill_DMAbuffer; near; external;
  206. procedure mixroutines; near; external;
  207.  
  208. { getuseddevice is not implemented yet }
  209. FUNCTION getuseddevice(var typ:byte;var base:word;var dma8,dma16:byte; var irq:byte):byte;
  210. { = 0 ... no device set / = 1 ... use SB mixing / > 1 ... other devices not supported yet }
  211. { typ ... up2now only SB typ - look at BLASTER.PAS }
  212. begin end;
  213.  
  214. PROCEDURE done_module;
  215. var i:word;
  216.     p:pointer;
  217.     psmp:PsmpHeader;
  218.   BEGIN
  219.     if not S3M_inMemory then exit;
  220.     { Free samples & instruments : }
  221.     for i:=1 to MAX_Samples do
  222.       begin
  223.         psmp:=addr(Instruments^[i]);
  224.         if (psmp^.typ=1) then
  225.           begin
  226.             if psmp^.mempos<$f000 then { no EMS instrument }
  227.               begin
  228.                 p:=ptr(psmp^.mempos,0);
  229.                 psmp^.mempos:=0;
  230.                 if p<>Nil then freedosmem(p);
  231.               end;
  232.           end;
  233.         Instruments^[i,0]:=0;
  234.       end;
  235.     { Free patterns : }
  236.     for i:=0 to MAX_patterns do
  237.       begin
  238.         if pattern[i]<$C000 then
  239.           begin
  240.             { pattern in normal memory - it's a shame :) }
  241.             p:=ptr(PATTERN[i],0);
  242.             if p<>Nil then freedosmem(p);
  243.             Pattern[i]:=0;
  244.           end;
  245.       end;
  246.     if EMSpat then { patterns in EMS }
  247.       begin
  248.         EMSfree(savHandle);
  249.         EMSfree(patEMShandle);EMSpat:=false;
  250.       end;
  251.     if EMSsmp then { samples in EMS }
  252.       begin
  253.         EMSfree(smpEMShandle);EMSsmp:=false;
  254.       end;
  255.     S3M_inMemory:=false;
  256.   END;
  257.  
  258. PROCEDURE Done_S3Mplayer;
  259.   begin
  260.     restore_irq;
  261.     if volumetablePtr<>Nil then freeDOSmem(volumetableptr);
  262.     if AllocBuffer<>Nil then freeDOSmem(AllocBuffer);
  263.     if Tickbuffer<>Nil then freeDOSmem(TickBuffer);
  264.     buffersreserved:=false;
  265.     playbuffer:=Nil;
  266.     DMABuffer:=Nil;
  267.   end;
  268.  
  269. PROCEDURE NewExitRoutine; Far;
  270.   begin
  271.     stop_play; { halt SB :) }
  272.     speaker_off; { switch it off ... }
  273.     if S3M_inMemory then done_module;
  274.     if buffersreserved then done_S3Mplayer else restore_irq;
  275.     exitproc:=oldexitproc;
  276.   end;
  277.  
  278. {$I LOADPROC.INC}
  279.  
  280. FUNCTION Init_device(input:byte):boolean;
  281. {  input= 0 ... use settings in BLASTER unit
  282.         = 1 ... hardware autodetect SB
  283.         = 2 ... read blaster enviroment
  284.         = 3 ... input by hand }
  285.   begin
  286.     Init_device:=false;
  287.     if Input = 0 then { 'checkthem' not yet implemented } sounddevice:=true
  288.     else
  289.     if Input = 1 then Sounddevice:=DetectSoundblaster(true)
  290.     else
  291.     if Input = 2 then Sounddevice:=UseBlasterEnv
  292.     else
  293.     if Input = 3 then Sounddevice:=InputSoundblasterValues;
  294.     Init_device:=Sounddevice;
  295.   end;
  296.  
  297. function checkoverride(var p;l:word):boolean; assembler;
  298.   asm
  299.     mov     bx,1
  300.     mov     ax,word ptr [p+2]
  301.     rol     ax,4
  302.     and     al,00fh
  303.     add     ax,l
  304.     jc      @@anoverride
  305.     xor     bx,bx
  306. @@anoverride:
  307.     mov     ax,bx
  308.   end;
  309.  
  310. FUNCTION Init_S3Mplayer:boolean;
  311. var p:pArray;
  312.   begin
  313.     Init_S3Mplayer:=false;
  314.     if not proc386 then begin player_error:=nota386orhigher;exit end;
  315.     if buffersreserved then begin player_error:=Allreadyallocbuffers;Init_S3Mplayer:=true;exit end;
  316.     { buffersreserved = false ! }
  317.     if not getdosmem(volumetablePTR,65*256*2) then begin player_error:=notenoughmem;exit end;
  318.     if not getdosmem(Allocbuffer,(DMABuffersize+15)*2) then begin player_error:=notenoughmem;exit end;
  319.     { ok and now check for DMA page overrides }
  320.     if checkoverride(Allocbuffer^,DMAbuffersize) then
  321.       { it's a page override in first DMAbuffer - use second }
  322.       begin
  323.         { Can't free the first part - sorry it's not possible with a DOS function }
  324.         { I know I can creat my own PSP etc., maybe later, ok ? - it's a problem  }
  325.         { for final activities. }
  326.         p:=allocBuffer;
  327.         DMAbuffer:=ptr(seg(p^)+Dmabuffersize div 16,0);
  328.         {$IFDEF BETATEST}
  329.         write(' Use second part of DMAbuffer ... at ',seg(Dmabuffer^));
  330.         {$ENDIF}
  331.       end
  332.     else
  333.       begin
  334.         { use first buffer and free the rest }
  335.         {setsize(Allocbuffer,DMABuffersize);}
  336.         DMAbuffer:=AllocBuffer;
  337.         {$IFDEF BETATEST}
  338.         write(' Use first part of DMAbuffer ... at ',seg(DMAbuffer^));
  339.         {$ENDIF}
  340.       end;
  341.     {
  342.       in tick buffer we calc one DMA buffer half - that are dmabuffersize/2 words
  343.     }
  344.     if not getdosmem(Tickbuffer,DMAbuffersize) then
  345.       begin
  346.         freedosmem(Allocbuffer);
  347.         freedosmem(VolumetablePTR);
  348.         player_error:=notenoughmem;
  349.         exit
  350.       end;
  351.     playBuffer:=DMABuffer;
  352.     buffersreserved:=true;
  353.     { clear those buffers : }
  354.     fillchar(dmabuffer^,dmabuffersize,0);
  355.     fillchar(tickbuffer^,dmabuffersize,0);
  356.     fillchar(volumetablePtr^,65*256*2,0);
  357.     Init_S3Mplayer:=true;
  358.   end;
  359.  
  360. PROCEDURE setSampleRate(var SR:word;stereo:boolean);
  361. var w:word;
  362.     i,j:byte;
  363.   begin
  364.     check_Samplerate(SR,stereo);Samplerate :=SR;
  365.  
  366.     if LQmode then
  367.       Userate:=SR div 2
  368.     else
  369.       Userate:=SR;
  370.  
  371.     w:=(1+ord(stereo))*(trunc(1000000/(trunc(1000000/Userate))/FPS)+1);
  372.     i:=DMAbuffersize div w;
  373.     j:=1;while j<i do j:=j shl 1;j:=j shr 1;
  374.     if LQmode then j:=j shr 1;
  375.     for i:=0 to j-1 do
  376.       dmarealbufsize[i]:=i*w;
  377.     NumBuffers:=j;
  378.   end;
  379.  
  380. procedure set_tempo(tempo:byte); far;
  381.   begin
  382.     if (tempo>=32) then
  383.       begin
  384.         curtempo:=tempo;
  385.       end
  386.     else tempo:=curtempo;
  387.     if curtempo<>0 then BPT:=trunc(Userate/50*125/curtempo);
  388.   end;
  389.  
  390. function getspeed:byte;
  391.   begin
  392.     getspeed:=curspeed;
  393.   end;
  394.  
  395. function gettempo:byte;
  396.   begin
  397.     gettempo:=curtempo
  398.   end;
  399.  
  400. var inside:boolean;
  401.  
  402. PROCEDURE PLAY_IRQ; interrupt;
  403. var x,y:integer;
  404.   begin
  405.     asm
  406.       cli
  407.     @wait:
  408.       cmp       [inside],1
  409.       je        @wait
  410.       mov       [inside],1
  411.       { change DMAhalf: }
  412.       mov       ah,[numbuffers]
  413.       dec       ah
  414.       inc       [DMAhalf]
  415.       and       [DMAhalf],ah
  416.       mov       [inside],0
  417.     end;
  418.     if rastertime then
  419.       asm
  420.         { set screen border, if user wants to know testing ... }
  421.         mov             dx,03dah
  422.         in              al,dx
  423.         mov             dx,03c0h
  424.         mov             al,31h
  425.         out             dx,al
  426.         mov             al,1
  427.         out             dx,al
  428.       end;
  429.     asm
  430.       { ackknowledge the interrupt on SB : }
  431.       mov       dx,dsp_addr
  432.       add       dx,0eh
  433.       add       dl,[_16Bit]         { in 16Bit mode we have to ackknowledge 22f ;) }
  434.       in        al,dx
  435.       { ackknowledge the hardwareinterrupt : }
  436.       mov       al,20h
  437.       out       0A0h,al
  438.       out       020h,al
  439.       { now new hardware interrupts are allowed ! }
  440.     end;
  441.     fill_dmabuffer;
  442.     if rastertime then
  443.       asm
  444.         { screen border back to black ... }
  445.         mov             dx,03dah
  446.         in              al,dx
  447.         mov             dx,03c0h
  448.         mov             al,31h
  449.         out             dx,al
  450.         mov             al,0
  451.         out             dx,al
  452.         sti
  453.       end;
  454.   end;
  455.  
  456. procedure calcposttable(use16bit:boolean);
  457. var z,i:integer;
  458.     a,b,c:real;
  459.     p:pointer;
  460.   begin
  461.     if use16bit then
  462.       begin { not implemented yet }
  463.       end
  464.     else
  465.       begin
  466.         z:=mvolume and 127;
  467.         c:=256*127/z;
  468.         a:=2048-c/2;
  469.         b:=2048+c/2;
  470.         for i:=0 to 4095 do
  471.           begin
  472.             if (i<a) then post8bit[i]:=0 else
  473.             if (i>b) then post8bit[i]:=255 else
  474.             post8bit[i]:=trunc((i-a)*z/128);
  475.           end;
  476.       end;
  477.   end;
  478.  
  479. procedure Initchannels;
  480. var i:byte;
  481.   begin
  482.     for i:=0 to usedchannels-1 do
  483.       begin
  484.         channel[i].VibTabOfs:=ofs(sinuswave);
  485.         channel[i].TrmTabOfs:=ofs(sinuswave);
  486.       end;
  487.   end;
  488.  
  489. procedure set_mastervolume(vol:byte);
  490.   begin
  491.     if vol>127 then vol:=127;
  492.     mvolume:=vol;
  493.     calcposttable(_16bit);
  494.   end;
  495.  
  496. function get_mvolume:byte;
  497.   begin
  498.     get_mvolume:=mvolume;
  499.   end;
  500.  
  501. function get_delay:byte;
  502.   begin
  503.     get_delay:=patterndelay;
  504.   end;
  505.  
  506. function getSamplerate:word;
  507.   begin
  508.     getSamplerate:=Samplerate;
  509.   end;
  510.  
  511. function handlesize(h:word):word; assembler;
  512.     asm
  513.       mov       ah,4ch
  514.       mov       dx,h
  515.       int       67h
  516.       cmp       ah,0
  517.       jz        @@ok
  518.       xor       bx,bx
  519. @@ok: mov       ax,bx
  520.     end;
  521.  
  522. function getusedEMSsmp:longint;    { get size of samples in EMS }
  523.   begin
  524.     if EMSsmp then getusedEMSsmp:=16*handlesize(smpEMShandle) else getusedEMSsmp:=0;
  525.   end;
  526.  
  527. function getusedEMSpat:longint;    { get size of patterns in EMS }
  528.   begin
  529.     if EMSpat then getusedEMSpat:=16*handlesize(patEMShandle) else getusedEMSpat:=0;
  530.   end;
  531.  
  532. procedure set_ST3order(new:boolean);
  533. var i:byte;
  534.   begin
  535.     ST3order:=new;
  536.     if new then
  537.       begin
  538.         { search for first '--' }
  539.         i:=0;
  540.         while (i<ordnum-1) and (order[i]<255) do inc(i);
  541.         dec(i);
  542.         lastorder:=i
  543.       end
  544.     else
  545.       begin
  546.         { just for fun (is not important,
  547.           you can also do simply lastorder=ordnum-1 }
  548.         i:=ordnum-1;
  549.         while (i>0) and (order[i]>=254) do dec(i);
  550.         lastorder:=i;
  551.       end;
  552.   end;
  553.  
  554. FUNCTION startplaying(var A_stereo,A_16Bit:boolean;LQ:Boolean):boolean;
  555. var key:boolean;
  556.     p:parray;
  557.   begin
  558.     startplaying:=false;
  559.     player_error:=0;
  560.     lqmode:=LQ;
  561.     A_stereo:=A_Stereo and Stereo_possible;
  562.     A_16Bit:=A_16Bit and _16Bit_possible;
  563.     if not sounddevice then begin player_error:=nosounddevice;exit; end; { sorry no device was set }
  564.     if not S3M_inMemory then begin player_error:=noS3Minmemory;exit end; { hmm load it first ;) }
  565.     set_ready_irq(@play_irq);
  566.     Initblaster(Samplerate,a_stereo,a_16Bit);
  567.     setSamplerate(Samplerate,a_stereo);
  568.     calcVolumetable; { <- now after loading we know if signed data or not }
  569.     calcposttable(A_16bit);
  570.     curtick:=1; { last tick -> goto next note ! }
  571.     curLine:=0; { <- next line to read from }
  572.     {$IFDEF BETATEST}
  573.     curorder:=startorder;
  574.     {$ELSE}
  575.     curOrder:=0; { <- next order to read from }
  576.     {$ENDIF}
  577.     curpattern:=order[0]; { next pattern to read from }
  578.     patterndelay:=0;      { no patterndelay at start of course ! }
  579.     Ploop_on:=false;
  580.     Ploop_to:=0;
  581.     curspeed:=initspeed;set_tempo(inittempo);
  582.     set_ST3order(ST3order); { <- don't remove this ! it's important ! (setup lastorder) }
  583.     EndOfSong:=false;toslow:=false;
  584.     TickBytesLeft:=0;       { emmidiately next tick }
  585.     Initchannels;
  586.     if lqmode then
  587.       begin
  588.         set_DMAvalues(DMABuffer,2*(numBuffers*DMArealbufsize[1]),true); { loop through whole DMAbuffer }
  589.  
  590.         DMAhalf:=numbuffers-1;
  591.         lastready:=numbuffers;
  592.         fill_dmabuffer; { calc all buffer parts ... }
  593.  
  594.         play_firstblock(2*dmarealbufsize[1]); { double buffering  }
  595.       end
  596.     else
  597.       begin
  598.         set_DMAvalues(DMABuffer,NumBuffers*DMArealbufsize[1],true); { loop through whole DMAbuffer }
  599.  
  600.         DMAhalf:=numbuffers-1;
  601.         lastready:=numbuffers;
  602.         fill_dmabuffer; { calc all buffer parts ... }
  603.  
  604.         play_firstblock(dmarealbufsize[1]); { double buffering  }
  605.       end;
  606.     { ok, now everything works in background ... }
  607.     startplaying:=true;
  608.   end;
  609.  
  610. VAR i:byte;
  611.  
  612. procedure calcwaves;
  613.   begin
  614.     for i:=0 to 63 do
  615.       begin
  616.         squarewave[i]:=255*ord(i<64);
  617.         sinuswave[i] :=round(sin(pi/32*i)*(127));
  618.         rampwave[i]  :=i*2-127;
  619.       end;
  620.   end;
  621.  
  622. BEGIN
  623.   inside:=false;
  624.  
  625.  
  626.   PROC386:=check386;
  627.   calcwaves;
  628.   buffersreserved:=false;
  629.   sounddevice:=false;
  630.   oldexitproc:=exitproc;
  631.   exitproc:=@newExitRoutine;
  632.   volumetablePTR:=Nil;
  633.   DMAbuffer:=Nil;
  634.   AllocBuffer:=Nil;
  635.   playBuffer:=Nil;
  636.   Tickbuffer:=Nil;
  637.   Samplerate:=22000; { not the highest but nice sounding samplerate :) }
  638.   Userate:=22000;
  639.   loopS3M:=false;
  640.   ST3order:=false;   { Ok let's hear all patterns are saved ... }
  641.   rastertime:=false;
  642.   useEMS:=EMSinstalled;      { more space for Modules ! }
  643.   if not getdosmem(instruments,5*16*max_samples) then
  644.     begin
  645.       asm
  646.         mov     ax,3
  647.         int     10h
  648.       end;
  649.       writeln(' Hey S3M-Player needs some DOSmem (programmers info: lower PAS-heap !) ');
  650.       halt(1);
  651.     end;
  652.  
  653.   FOR i:=1 TO MAX_Samples DO
  654.     BEGIN
  655.       Instruments^[i,0]:=0;
  656.     END;
  657.   FOR i:=0 TO MAX_patterns-1 DO
  658.     BEGIN
  659.       PATTERN[i]:=0;
  660.     END;
  661.   FPS:=70;
  662.   LQmode:=false;
  663. END.